home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 014 / pibcat.arc / PIBCAT.PAS < prev    next >
Pascal/Delphi Source File  |  1987-01-20  |  37KB  |  910 lines
  1. (*$V-,G64,P128,R-,K-,C-,U-*)
  2. PROGRAM PibCat;
  3.  
  4. (*----------------------------------------------------------------------*)
  5. (*                                                                      *)
  6. (*    Program: PIBCAT --- Catalog files on a disk.                      *)
  7. (*                                                                      *)
  8. (*    Author:  Philip R. Burns.                                         *)
  9. (*                                                                      *)
  10. (*    Version: 1.0    January 20, 1987.                                 *)
  11. (*                                                                      *)
  12. (*    Usage:                                                            *)
  13. (*           PIBCAT v /f=filespec /i=indent /m=margin                   *)
  14. (*                    /o=filename /p=pagesize /x                        *)
  15. (*                                                                      *)
  16. (*            v               volume (drive letter) to catalog          *)
  17. (*                            (default is current drive)                *)
  18. (*                            If given as ?, this text is displayed.    *)
  19. (*            /f=filespec     DOS file spec to match when listing       *)
  20. (*                            (default is *.* -- list all files)        *)
  21. (*            /i=indent       # columns to space for .ARC/.LBR entries  *)
  22. (*                            (default is 0)                            *)
  23. (*            /m=margin       left margin to leave (default is 0)       *)
  24. (*            /o=filename     write catalog listing to file "filename"  *)
  25. (*                            (default is "CATALOG.LIS")                *)
  26. (*            /p=pagesize     paginate listing using "pagesize" lines   *)
  27. (*                            (default is no pagination)                *)
  28. (*            /x              don't list .ARC/.LBR file contents        *)
  29. (*                            (default is to list .ARC/.LBR contents)   *)
  30. (*                                                                      *)
  31. (*    Aborting:  Hit ^C to abort catalog listing.                       *)
  32. (*                                                                      *)
  33. (*    Output:                                                           *)
  34. (*                                                                      *)
  35. (*       For each selected file, the file name, size in bytes, and time *)
  36. (*       and date of creation are displayed.  The same information is   *)
  37. (*       given for members of .ARC or .LBR files.                       *)
  38. (*                                                                      *)
  39. (*    Acknowledgments:                                                  *)
  40. (*                                                                      *)
  41. (*       The archive search code is based upon TPARCV.PAS written by    *)
  42. (*       Michael Quinlan and ARCV.ASM written by Vern Buerg.            *)
  43. (*                                                                      *)
  44. (*       The library search code is based upon LU.PAS written by        *)
  45. (*       Steve Freeman.                                                 *)
  46. (*                                                                      *)
  47. (*----------------------------------------------------------------------*)
  48.  
  49.                                    (* Global declarations *)
  50. (*$I PIBCAT.GLO   *)
  51.                                    (* General service subroutines *)
  52. (*$I PIBCATS.PAS  *)
  53.  
  54. (*----------------------------------------------------------------------*)
  55. (*        Display_Help  --- Display help screen for PibCat              *)
  56. (*----------------------------------------------------------------------*)
  57.  
  58. PROCEDURE Display_Help;
  59.  
  60. BEGIN (* Display_Help *)
  61.  
  62.    WRITELN;
  63.    WRITELN('Program: PIBCAT --- Catalog files on a disk.');
  64.    WRITELN('Author:  Philip R. Burns.');
  65.    WRITELN('Version: 1.0    January 20, 1987.');
  66.    WRITELN('Usage:   PIBCAT v /f=filespec /i=indent /m=margin /o=filename /p=pagesize /x');
  67.    WRITELN('                v               volume (drive letter) to catalog');
  68.    WRITELN('                                (default is current drive)');
  69.    WRITELN('                                If given as ?, this text is displayed.');
  70.    WRITELN('                /f=filespec     DOS file spec to match when listing');
  71.    WRITELN('                                (default is *.* -- list all files)');
  72.    WRITELN('                /i=indent       # columns to space for .ARC/.LBR entries');
  73.    WRITELN('                                (default is 0)');
  74.    WRITELN('                /m=margin       left margin to leave (default is 0)');
  75.    WRITELN('                /o=filename     write catalog listing to file "filename"');
  76.    WRITELN('                                (default is "CATALOG.LIS")');
  77.    WRITELN('                /p=pagesize     paginate listing using "pagesize" lines');
  78.    WRITELN('                                (default is no pagination)');
  79.    WRITELN('                /x              don''t list .ARC/.LBR files contents');
  80.    WRITELN('                                (default is to list .ARC/.LBR contents)');
  81.    WRITELN;
  82.    WRITELN('Aborting:  Hit ^C to abort catalog listing.');
  83.    WRITELN;
  84.  
  85. END   (* Display_Help *);
  86.  
  87. (*----------------------------------------------------------------------*)
  88. (*             Initialize --- Initialize PibCat program                 *)
  89. (*----------------------------------------------------------------------*)
  90.  
  91. FUNCTION Initialize : BOOLEAN;
  92.  
  93. VAR
  94.    S    : AnyStr;
  95.    S2   : AnyStr;
  96.    I    : INTEGER;
  97.    J    : INTEGER;
  98.    Ierr : INTEGER;
  99.  
  100. (* STRUCTURED *) CONST
  101.    Legit_Drives : SET OF CHAR = ['A'..'Z','?'];
  102.  
  103. BEGIN (* Initialize *)
  104.                                    (* --- Set defaults --- *)
  105.  
  106.                                    (* Drive to catalog is current drive *)
  107.  
  108.    Cat_Drive         := Dir_Get_Default_Drive;
  109.  
  110.                                    (* Default output file is CATALOG.LIS *)
  111.  
  112.    Output_File_Name  := 'CATALOG.LIS';
  113.  
  114.                                    (* Don't produce paginated listing file *)
  115.    Do_Printer_Format := FALSE;
  116.    Page_Size         := 0;
  117.                                    (* No extra spaces at left margin *)
  118.    Left_Margin       := 0;
  119.                                    (* No extra indent for .ARC/.LBR *)
  120.    ArcLbr_Indent     := 0;
  121.                                    (* List contents of .ARC/.LBR files *)
  122.    Expand_Arcs       := TRUE;
  123.                                    (* No ^C hit yet terminating cataloguing *)
  124.    User_Break        := FALSE;
  125.                                    (* Catalog all files by default *)
  126.    Find_Spec         := '*.*';
  127.                                    (* We start on first page *)
  128.    Page_Number       := 1;
  129.                                    (* Lots of lines left on this page *)
  130.    Lines_Left        := 32767;
  131.                                    (* No files yet *)
  132.    File_Count  := 0;
  133.    Total_Files := 0;
  134.    Total_Space := 0;
  135.    Total_Dirs  := 0;
  136.                                    (* No titles yet *)
  137.    Volume_Title := '';
  138.    Subdir_Title := '';
  139.    File_Title   := '';
  140.                                    (* Not help mode only *)
  141.    Help_Only    := FALSE;
  142.                                    (* Grab command line parameters *)
  143.    FOR I := 1 TO ParamCount DO
  144.       BEGIN
  145.  
  146.          S := UpperCase( ParamStr( I ) );
  147.  
  148.          IF ( S[1] = '/' ) THEN
  149.             BEGIN
  150.  
  151.                IF ( S[3] = '=' ) THEN
  152.                   S2 := Substr( S, 4, LENGTH( S ) - 3 )
  153.                ELSE
  154.                   S2 := '';
  155.  
  156.                CASE UpCase( S[2] ) OF
  157.  
  158.                   'F':  BEGIN
  159.                            IF ( S2 <> '' ) THEN
  160.                               Find_Spec := S2;
  161.                         END;
  162.  
  163.                   'I':  BEGIN
  164.                            VAL( S2, J, Ierr );
  165.                            IF ( Ierr = 0 ) THEN
  166.                               ArcLbr_Indent := J;
  167.                         END;
  168.  
  169.                   'M':  BEGIN
  170.                            VAL( S2, J, Ierr );
  171.                            IF ( Ierr = 0 ) THEN
  172.                               Left_Margin := J;
  173.                         END;
  174.  
  175.                   'O':  Output_File_Name := S2;
  176.  
  177.                   'P':  BEGIN
  178.                            VAL( S2, J, Ierr );
  179.                            IF ( Ierr = 0 ) THEN
  180.                               BEGIN
  181.                                  Page_Size  := J;
  182.                                  Lines_Left := J;
  183.                               END;
  184.                            Do_Printer_Format := ( Page_Size > 0 );
  185.                         END;
  186.  
  187.                   'X':  Expand_Arcs       := FALSE;
  188.  
  189.                   ELSE;
  190.  
  191.                END (* CASE *);
  192.  
  193.             END
  194.          ELSE
  195.             IF Cat_Drive IN Legit_Drives THEN
  196.                Cat_Drive := S[1];
  197.       END;
  198.                                    (* If the drive was a "?" then we have  *)
  199.                                    (* a help request.  Display help info   *)
  200.                                    (* and quit.                            *)
  201.    IF ( Cat_Drive = '?' ) THEN
  202.       BEGIN
  203.          Display_Help;
  204.          Initialize := FALSE;
  205.          Help_Only  := TRUE;
  206.          EXIT;
  207.       END;
  208.                                    (* Get string of blanks for left margin *)
  209.  
  210.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  211.  
  212.                                    (* Open output file *)
  213.       (*$I-*)
  214.    ASSIGN( Output_File , Output_File_Name );
  215.    REWRITE( Output_File );
  216.       (*$I+*)
  217.                                    (* Continue if we got it *)
  218.    IF ( IOResult = 0 ) THEN
  219.       Initialize := TRUE
  220.    ELSE
  221.       BEGIN
  222.          WRITELN;
  223.          WRITELN( 'Can''t open output file ', Output_File_Name );
  224.          WRITELN;
  225.          Initialize := FALSE;
  226.       END;
  227.  
  228. END   (* Initialize *);
  229.  
  230. (*----------------------------------------------------------------------*)
  231. (*     Display_Volume_Label   ---  Display volume label of disk         *)
  232. (*----------------------------------------------------------------------*)
  233.  
  234. PROCEDURE Display_Volume_Label;
  235.  
  236. VAR
  237.    Volume_Label : AnyStr;
  238.    Vol_Time     : INTEGER;
  239.    Vol_Date     : INTEGER;
  240.    STime        : STRING[10];
  241.    SDate        : STRING[10];
  242.  
  243. BEGIN (* Display_Volume_Label *)
  244.  
  245.                                    (* Blank out volume title line *)
  246.  
  247.    Volume_Title := DUPL( ' ' , 80 );
  248.  
  249.                                    (* Get volume label from DOS *)
  250.  
  251.    Dir_Get_Volume_Label( Cat_Drive, Volume_Label, Vol_Date, Vol_Time );
  252.  
  253.    WRITELN( Output_File );
  254.                                    (* If no volume label, don't output it. *)
  255.  
  256.    IF ( Volume_Label = '' ) THEN
  257.       BEGIN
  258.  
  259.          Volume_Title := Left_Margin_String              +
  260.                          ' Contents of volume on drive ' +
  261.                          Cat_Drive                       +
  262.                          ' as of '                       +
  263.                          DateString                      +
  264.                          ' at '                          +
  265.                          TimeOfDayString;
  266.  
  267.          IF Do_Printer_Format THEN
  268.             BEGIN
  269.                WRITELN( Output_File , FF_Char );
  270.                WRITE  ( Output_File , Volume_Title );
  271.                WRITELN( Output_File , '     Page ', Page_Number );
  272.             END
  273.          ELSE
  274.             WRITELN( Output_File , Volume_Title );
  275.  
  276.          Lines_Left := Lines_Left - 1;
  277.  
  278.       END
  279.    ELSE
  280.                                    (* If volume label, output it along with *)
  281.                                    (* its creation time and date.           *)
  282.       BEGIN
  283.  
  284.          Volume_Title := Left_Margin_String        +
  285.                          ' Contents of volume '    +
  286.                          Volume_Label              +
  287.                          ' as of '                 +
  288.                          DateString                +
  289.                          ' at '                    +
  290.                          TimeOfDayString;
  291.  
  292.          IF Do_Printer_Format THEN
  293.             BEGIN
  294.                WRITELN( Output_File , FF_Char );
  295.                WRITE  ( Output_File , Volume_Title );
  296.                WRITELN( Output_File , '     Page ', Page_Number );
  297.             END
  298.          ELSE
  299.             WRITELN( Output_File , Volume_Title );
  300.  
  301.          Volume_Label := Volume_Label + DUPL( ' ' , 12 - LENGTH( Volume_Label ) );
  302.  
  303.          Dir_Convert_Date( Vol_Date , SDate );
  304.          Dir_Convert_Time( Vol_Time , STime );
  305.  
  306.          WRITELN( Output_File );
  307.          WRITE  ( Output_File , Left_Margin_String,
  308.                   ' Volume:  ',Volume_Label, '     Created: ',
  309.                   SDate, ' ', STime );
  310.  
  311.          Lines_Left := Lines_Left - 3;
  312.  
  313.       END;
  314.  
  315.    WRITELN( Output_File );
  316.                                    (* Count lines left on page *)
  317.    Lines_Left := Lines_Left - 2;
  318.  
  319. END   (* Display_Volume_Label *);
  320.  
  321. (*----------------------------------------------------------------------*)
  322. (*     Display_Page_Titles  ---  Display page titles at top of page     *)
  323. (*----------------------------------------------------------------------*)
  324.  
  325. PROCEDURE Display_Page_Titles;
  326.  
  327. (*----------------------------------------------------------------------*)
  328. (*                                                                      *)
  329. (*    Procedure: Display_Page_Titles;                                   *)
  330. (*                                                                      *)
  331. (*    Purpose:   Displays page headers for paginated output file        *)
  332. (*                                                                      *)
  333. (*    Calling sequence:                                                 *)
  334. (*                                                                      *)
  335. (*       Display_Page_Titles;                                           *)
  336. (*                                                                      *)
  337. (*----------------------------------------------------------------------*)
  338.  
  339. BEGIN (* Display_Page_Titles *)
  340.  
  341.                                    (* Skip to top of new page using FF *)
  342.    WRITELN( Output_File , FF_Char );
  343.  
  344.                                    (* Reset lines left to page size    *)
  345.    Lines_Left := Page_Size;
  346.                                    (* Increment page count             *)
  347.  
  348.    Page_Number := SUCC( Page_Number );
  349.  
  350.                                    (* Display extant titles            *)
  351.                                    (*   -- Volume title                *)
  352.  
  353.    WRITELN( Output_File );
  354.    WRITELN( Output_File , Volume_Title , '     Page ', Page_Number );
  355.    WRITELN( Output_File );
  356.                                    (*   -- Subdirectory title          *)
  357.    WRITELN( Output_File , Subdir_Title );
  358.    WRITELN( Output_File );
  359.  
  360.    Lines_Left := Lines_Left - 5;
  361.  
  362.    IF ( File_Title <> '' ) THEN
  363.       BEGIN
  364.                                    (*   -- File title          *)
  365.  
  366.          WRITELN( Output_File , File_Title );
  367.          WRITELN( Output_File );
  368.  
  369.          Lines_Left := Lines_Left - 2;
  370.  
  371.       END;
  372.  
  373. END   (* Display_Page_Titles *);
  374.                                    (* Archive display routines *)
  375. (*$I PIBCATA.PAS *)
  376.                                    (* Library display routines *)
  377. (*$I PIBCATL.PAS *)
  378.  
  379. (*----------------------------------------------------------------------*)
  380. (*          Move_File_Info --- Save file information for sorting        *)
  381. (*----------------------------------------------------------------------*)
  382.  
  383. PROCEDURE Move_File_Info(     Full : Directory_Record;
  384.                           VAR Short: Short_Dir_Record );
  385.  
  386. (*----------------------------------------------------------------------*)
  387. (*                                                                      *)
  388. (*    Procedure: Move_File_Info                                         *)
  389. (*                                                                      *)
  390. (*    Purpose:   Saves information about file in compact form           *)
  391. (*                                                                      *)
  392. (*    Calling sequence:                                                 *)
  393. (*                                                                      *)
  394. (*       Move_File_Info(     Full : Directory_Record;                   *)
  395. (*                       VAR Short: Short_Dir_Record );                 *)
  396. (*                                                                      *)
  397. (*          Full  --- Directory info as retrieved from DOS              *)
  398. (*          Short --- Directory info with garbage thrown out            *)
  399. (*                                                                      *)
  400. (*    Remarks:                                                          *)
  401. (*                                                                      *)
  402. (*       This routine copies the useful stuff about a file to a         *)
  403. (*       shorter record which is more easily sorted.                    *)
  404. (*                                                                      *)
  405. (*----------------------------------------------------------------------*)
  406.  
  407. BEGIN (* Move_File_Info *)
  408.  
  409.    Short.File_Date    := Full.File_Date;
  410.    Short.File_Time    := Full.File_Time;
  411.    Short.File_Size    := Full.File_Size;
  412.    Short.File_Attr    := Full.File_Attr;
  413.    Short.File_Name    := COPY( Full.File_Name, 1,
  414.                                POS( #0 , Full.File_Name ) - 1 );
  415.  
  416. END   (* Move_File_Info *);
  417.  
  418. (*----------------------------------------------------------------------*)
  419. (*        Display_File_Info --- Display information about a file        *)
  420. (*----------------------------------------------------------------------*)
  421.  
  422. PROCEDURE Display_File_Info( Dir_Entry : Short_Dir_Record );
  423.  
  424. (*----------------------------------------------------------------------*)
  425. (*                                                                      *)
  426. (*    Procedure: Display_File_Info                                      *)
  427. (*                                                                      *)
  428. (*    Purpose:   Displays information for current file                  *)
  429. (*                                                                      *)
  430. (*    Calling sequence:                                                 *)
  431. (*                                                                      *)
  432. (*       Display_File_Info( Dir_Entry : Short_Dir_Record );             *)
  433. (*                                                                      *)
  434. (*          Dir_Entry --- Directory record describing file              *)
  435. (*                                                                      *)
  436. (*    Remarks:                                                          *)
  437. (*                                                                      *)
  438. (*       The counters for total number of files and total file space    *)
  439. (*       used are incremented here.                                     *)
  440. (*                                                                      *)
  441. (*----------------------------------------------------------------------*)
  442.  
  443. VAR
  444.    RLength : REAL;
  445.    STime   : STRING[10];
  446.    SDate   : STRING[10];
  447.    I       : INTEGER;
  448.  
  449. BEGIN (* Display_File_Info *)
  450.  
  451.    WITH Dir_Entry DO
  452.       BEGIN
  453.                                    (* Get length *)
  454.  
  455.          RLength := Long_To_Real( File_Size );
  456.  
  457.                                    (* Get date and time of creation *)
  458.  
  459.          Dir_Convert_Date( File_Date , SDate );
  460.          Dir_Convert_Time( File_Time , STime );
  461.  
  462.                                    (* Write out file name *)
  463.  
  464.          WRITE( Output_File , Left_Margin_String , '      ' , File_Name );
  465.  
  466.          FOR I := LENGTH( File_Name ) TO 13 DO
  467.             WRITE( Output_File , ' ');
  468.  
  469.                                    (* Write length, date, and time *)
  470.  
  471.          WRITE  ( Output_File , RLength:8:0, '  ' );
  472.          WRITE  ( Output_File , SDate, '  ' );
  473.          WRITE  ( Output_File , STime );
  474.          WRITELN( Output_File );
  475.                                    (* Count lines left on page *)
  476.          IF Do_Printer_Format THEN
  477.             BEGIN
  478.                Lines_Left := Lines_Left - 1;
  479.                IF ( Lines_Left < 1 ) THEN
  480.                   Display_Page_Titles;
  481.             END;
  482.  
  483.       END;
  484.                                    (* Increment total file count   *)
  485.  
  486.    Total_Files := Total_Files + 1;
  487.  
  488.                                    (* Increment total space used   *)
  489.  
  490.    Total_Space := Total_Space + RLength;
  491.  
  492. END   (* Display_File_Info *);
  493.  
  494. (*----------------------------------------------------------------------*)
  495. (*          Sort_Files --- Sort files in ascending order by name        *)
  496. (*----------------------------------------------------------------------*)
  497.  
  498. PROCEDURE Sort_Files( First : INTEGER;
  499.                       Last  : INTEGER );
  500.  
  501. (*----------------------------------------------------------------------*)
  502. (*                                                                      *)
  503. (*    Procedure: Sort_Files                                             *)
  504. (*                                                                      *)
  505. (*    Purpose:   Sorts file names in current directory                  *)
  506. (*                                                                      *)
  507. (*    Calling sequence:                                                 *)
  508. (*                                                                      *)
  509. (*       Sort_Files( First : INTEGER; Last : INTEGER );                 *)
  510. (*                                                                      *)
  511. (*          First --- First entry in 'File_Stack' to sort               *)
  512. (*          Last  --- Last entry in 'File_Stack' to sort                *)
  513. (*                                                                      *)
  514. (*    Remarks:                                                          *)
  515. (*                                                                      *)
  516. (*       A shell sort is used to put the file names for the current     *)
  517. (*       directory in ascending order.  The current directory's files   *)
  518. (*       are bracketed by 'First' and 'Last'.                           *)
  519. (*                                                                      *)
  520. (*----------------------------------------------------------------------*)
  521.  
  522. VAR
  523.    Temp : Short_Dir_Record;
  524.    I    : INTEGER;
  525.    J    : INTEGER;
  526.    D    : INTEGER;
  527.  
  528. BEGIN (* Sort_Files *)
  529.  
  530.    D := ( Last - First + 1 );
  531.  
  532.    WHILE( D > 1 ) DO
  533.       BEGIN
  534.  
  535.          IF ( D < 5 ) THEN
  536.             D := 1
  537.          ELSE
  538.             D := TRUNC( 0.45454 * D );
  539.  
  540.          FOR I := ( Last - D ) DOWNTO First DO
  541.             BEGIN
  542.  
  543.                Temp       := File_Stack[I];
  544.                J          := I + D;
  545.  
  546.                WHILE( ( Temp.File_Name > File_Stack[J].File_Name ) AND ( J <= Last ) ) DO
  547.                   BEGIN
  548.                      File_Stack[J-D] := File_Stack[J];
  549.                      J               := J + D;
  550.                   END;
  551.  
  552.                File_Stack[J-D] := Temp;
  553.  
  554.             END;
  555.  
  556.       END;
  557.  
  558. END   (* Sort_Files *);
  559.  
  560. (*----------------------------------------------------------------------*)
  561. (*          Find_Files --- Recursively search directories for files     *)
  562. (*----------------------------------------------------------------------*)
  563.  
  564. PROCEDURE Find_Files( VAR Subdir    : AnyStr;
  565.                       VAR File_Spec : AnyStr;
  566.                           Attr      : INTEGER;
  567.                           Levels    : INTEGER );
  568.  
  569. (*----------------------------------------------------------------------*)
  570. (*                                                                      *)
  571. (*    Procedure: Find_Files                                             *)
  572. (*                                                                      *)
  573. (*    Purpose:   Recursively traverses directories looking for files    *)
  574. (*                                                                      *)
  575. (*    Calling sequence:                                                 *)
  576. (*                                                                      *)
  577. (*       Find_Files( VAR Subdir    : AnyStr;                            *)
  578. (*                   VAR File_Spec : AnyStr;                            *)
  579. (*                       Attr      : INTEGER;                           *)
  580. (*                       Levels    : INTEGER );                         *)
  581. (*                                                                      *)
  582. (*          Subdir    --- subdirectory name of this level               *)
  583. (*          File_Spec --- DOS file spec to match                        *)
  584. (*          Attr      --- attribute type to match                       *)
  585. (*          Levels    --- current subdirectory level depth              *)
  586. (*                                                                      *)
  587. (*    Remarks:                                                          *)
  588. (*                                                                      *)
  589. (*       This is the actual heart of PibCat.  This routine invokes      *)
  590. (*       itself recursively to traverse all subdirectories looking for  *)
  591. (*       files which match the given file specification.                *)
  592. (*                                                                      *)
  593. (*----------------------------------------------------------------------*)
  594.  
  595. VAR
  596.    Dir_Entry  : Directory_Record;
  597.    Path       : AnyStr;
  598.    Error      : INTEGER;
  599.    I          : INTEGER;
  600.    Dir        : STRING[14];
  601.    Cur_Count  : INTEGER;
  602.    Skip_Attr  : INTEGER;
  603.    Files_Here : INTEGER;
  604.  
  605. LABEL  Quit;
  606.  
  607. BEGIN  (* Find_Files *)
  608.                                    (* Save current file count *)
  609.    Cur_Count  := File_Count;
  610.                                    (* No files in this directory yet *)
  611.    Files_Here := 0;
  612.                                    (* Don't list directories as files *)
  613.  
  614.    Skip_Attr := Attribute_Volume_Label + Attribute_Subdirectory;
  615.  
  616.    IF ( Levels >= 1 ) THEN
  617.       BEGIN
  618.                                    (* Get full file spec to search for *)
  619.  
  620.          Path := Subdir + File_Spec;
  621.  
  622.                                    (* Need "Z" format string for DOS *)
  623.  
  624.          Convert_String_To_AsciiZ( Path );
  625.  
  626.                                    (* Get first file on this level *)
  627.  
  628.          Error := Dir_Find_First_File( Path , Dir_Entry );
  629.  
  630.                                    (* Get info on remaining files  *)
  631.                                    (* on this level.               *)
  632.          WHILE ( Error = 0 ) DO
  633.             BEGIN
  634.                                    (* Increment count of files in this dir *)
  635.                                    (* including subdirectories             *)
  636.  
  637.                File_Count := SUCC( File_Count );
  638.  
  639.                                    (* Increment non-directory file count *)
  640.  
  641.                IF ( ( Dir_Entry.File_Attr AND Skip_Attr ) = 0 ) THEN
  642.                    Files_Here := SUCC( Files_Here );
  643.  
  644.                                    (* Save info on this file *)
  645.  
  646.                Move_File_Info ( Dir_Entry , File_Stack[File_Count] );
  647.  
  648.                                    (* Get next file entry *)
  649.  
  650.                Error := Dir_Find_Next_File( Dir_Entry );
  651.  
  652.                                    (* Check for ^C at keyboard *)
  653.                IF KeyPressed THEN
  654.                   IF QuitFound THEN
  655.                      GOTO Quit;
  656.  
  657.             END;
  658.                                    (* Sort file names              *)
  659.  
  660.          Sort_Files( Cur_Count + 1 , File_Count );
  661.  
  662.                                    (* Increment directory count    *)
  663.  
  664.          Total_Dirs  := Total_Dirs + 1;
  665.  
  666.                                    (* Report scanning this subdirectory *)
  667.  
  668.          WRITELN(' Scanning: ', Subdir );
  669.  
  670.                                    (* Display file info header *)
  671.  
  672.          IF ( Files_Here > 0 ) THEN
  673.             BEGIN
  674.  
  675.                Subdir_Title := Left_Margin_String + ' Directory: ' + Subdir;
  676.  
  677.                IF Do_Printer_Format THEN
  678.                   IF ( Lines_Left < 4 ) THEN
  679.                      Display_Page_Titles
  680.                   ELSE
  681.                      BEGIN
  682.                         WRITELN( Output_File );
  683.                         WRITELN( Output_File , Subdir_Title );
  684.                         WRITELN( Output_File );
  685.                      END
  686.                ELSE
  687.                   BEGIN
  688.                      WRITELN( Output_File );
  689.                      WRITELN( Output_File , Subdir_Title );
  690.                      WRITELN( Output_File );
  691.                   END;
  692.                                    (* Count lines left on page *)
  693.  
  694.                IF Do_Printer_Format THEN
  695.                   BEGIN
  696.                      Lines_Left := Lines_Left - 3;
  697.                      IF ( Lines_Left < 1 ) THEN
  698.                         Display_Page_Titles;
  699.                   END;
  700.  
  701.             END;
  702.                                    (* Display info on all files       *)
  703.                                    (* But don't display directories!  *)
  704.  
  705.          FOR I := ( Cur_Count + 1 ) TO File_Count DO
  706.              BEGIN
  707.                 IF ( ( File_Stack[I].File_Attr AND Skip_Attr ) = 0 ) THEN
  708.                    Display_File_Info( File_Stack[I] );
  709.                 IF KeyPressed THEN
  710.                    IF QuitFound THEN
  711.                       GOTO Quit;
  712.              END;
  713.                                    (* List .LBR/.ARC if requested *)
  714.          IF Expand_Arcs THEN
  715.             BEGIN
  716.                                    (* List contents of any .ARC files *)
  717.  
  718.                FOR I := ( Cur_Count + 1 ) TO File_Count DO
  719.                   BEGIN
  720.                      IF ( POS( '.ARC', File_Stack[I].File_Name ) > 0 ) THEN
  721.                         Display_Archive_Contents( Subdir + File_Stack[I].File_Name );
  722.                      IF KeyPressed THEN
  723.                         IF QuitFound THEN
  724.                            GOTO Quit;
  725.                   END;
  726.                                    (* List contents of any .LBR files *)
  727.  
  728.                FOR I := ( Cur_Count + 1 ) TO File_Count DO
  729.                   BEGIN
  730.                      IF ( POS( '.LBR', File_Stack[I].File_Name ) > 0 ) THEN
  731.                         Display_Lbr_Contents( Subdir + File_Stack[I].File_Name );
  732.                      IF KeyPressed THEN
  733.                         IF QuitFound THEN
  734.                            GOTO Quit;
  735.                   END;
  736.  
  737.             END;
  738.  
  739.          IF ( Levels >= 2 ) THEN
  740.             BEGIN
  741.                                    (* List all subdirectories to given level *)
  742.                                    (* Note: we read through whole directory  *)
  743.                                    (*       again since we probably excluded *)
  744.                                    (*       directories on first pass.       *)
  745.  
  746.                Path := Subdir + '*.*';
  747.                Convert_String_To_AsciiZ( Path );
  748.  
  749.                                    (* Get first file *)
  750.  
  751.                Error := Dir_Find_First_File( Path , Dir_Entry );
  752.  
  753.                                    (* While there are files left ... *)
  754.  
  755.                WHILE ( Error = 0 ) DO
  756.                   BEGIN
  757.                                    (* See if it's a subdirectory *)
  758.  
  759.                      IF ( ( Attribute_Subdirectory AND Dir_Entry.File_Attr ) <> 0 ) THEN
  760.                         BEGIN
  761.                                    (* Yes -- get subdirectory name *)
  762.  
  763.                            Dir := COPY( Dir_Entry.File_Name, 1,
  764.                                         POS( #0 , Dir_Entry.File_Name ) - 1 );
  765.  
  766.                                    (* Ignore '.' and '..' *)
  767.  
  768.                            IF ( ( Dir <> '.' ) AND ( Dir <> '..') ) THEN
  769.                               BEGIN
  770.  
  771.                                    (* Construct path name for subdirectory *)
  772.  
  773.                                  Path := Subdir + Dir + '\';
  774.  
  775.                                    (* List files in subdirectory *)
  776.  
  777.                                  Find_Files( Path, File_Spec, Attr, Levels - 1 );
  778.  
  779.                                  IF User_Break THEN
  780.                                     GOTO Quit;
  781.  
  782.                               END;
  783.  
  784.                         END;
  785.                                    (* Get next file entry *)
  786.  
  787.                      Error := Dir_Find_Next_File( Dir_Entry );
  788.  
  789.                   END (* WHILE *);
  790.  
  791.             END (* IF Levels >= 2 *);
  792.  
  793.       END (* IF Levels >= 1 *);
  794.                                    (* Restore previous file count *)
  795. Quit:
  796.    File_Count := Cur_Count;
  797.  
  798. END   (* Find_Files *);
  799.  
  800. (*----------------------------------------------------------------------*)
  801. (*             Perform_Cataloguing --- Do cataloguing of files          *)
  802. (*----------------------------------------------------------------------*)
  803.  
  804. PROCEDURE Perform_Cataloguing;
  805.  
  806. VAR
  807.    Name      : AnyStr;
  808.    Subdir    : AnyStr;
  809.    File_Spec : AnyStr;
  810.    I         : INTEGER;
  811.    L         : INTEGER;
  812.    Done      : BOOLEAN;
  813.  
  814. BEGIN (* Perform_Cataloguing *)
  815.                                    (* Display volume label       *)
  816.    Display_Volume_Label;
  817.                                    (* Append disk letter to file spec *)
  818.  
  819.    IF ( POS( '\' , Find_Spec ) = 0 ) THEN
  820.       Name := Cat_Drive + ':\' + Find_Spec
  821.    ELSE
  822.       Name := Cat_Drive + ':' + Find_Spec;
  823.  
  824.                                    (* Make sure some files get looked at! *)
  825.  
  826.    IF Name[LENGTH(Name)] = '\' THEN
  827.       Name := Name + '*.*';
  828.  
  829.                                    (* Split out directory from file spec *)
  830.    Subdir := Name;
  831.    I      := LENGTH( Subdir ) + 1;
  832.    Done   := FALSE;
  833.  
  834.    REPEAT
  835.       I := I - 1;
  836.       IF ( I > 0 ) THEN
  837.          Done := ( Subdir[I] = '\' )
  838.       ELSE
  839.          Done := TRUE;
  840.    UNTIL Done;
  841.  
  842.    I := LENGTH( Subdir ) - I;
  843.  
  844.    File_Spec[0] := CHR( I );
  845.  
  846.    MOVE( Subdir[ 1 + LENGTH( Subdir ) - I ] , File_Spec[ 1 ] , I );
  847.  
  848.    Subdir[0] := CHR( LENGTH( Subdir ) - I );
  849.  
  850.                                    (* Begin listing files at specified *)
  851.                                    (* subdirectory                     *)
  852.  
  853.    Find_Files( Subdir, File_Spec, $FF, 9999 );
  854.  
  855. END   (* Perform_Cataloguing *);
  856.  
  857. (*----------------------------------------------------------------------*)
  858. (*                Terminate --- Terminate cataloguing                   *)
  859. (*----------------------------------------------------------------------*)
  860.  
  861. PROCEDURE Terminate;
  862.  
  863. BEGIN (* Terminate *)
  864.                                    (* Note if catalogue terminated by ^C *)
  865.    IF ( NOT Help_Only ) THEN
  866.       IF User_Break THEN
  867.          BEGIN
  868.             IF ( Lines_Left < 6 ) THEN
  869.                Display_Page_Titles;
  870.             WRITELN( Output_File );
  871.             WRITELN( Output_File , Left_Margin_String,
  872.                      '>>>>> ^C typed, catalog listing INCOMPLETE.');
  873.             WRITELN( Output_File );
  874.             WRITELN( '^C typed, catalog listing INCOMPLETE.');
  875.          END
  876.       ELSE
  877.          BEGIN                        (* Indicate file totals *)
  878.             IF ( Lines_Left < 7 ) THEN
  879.                Display_Page_Titles;
  880.             WRITELN( Output_File );
  881.             WRITELN( Output_File , Left_Margin_String, ' Totals:');
  882.             WRITELN( Output_File , Left_Margin_String,
  883.                      '    Directories scanned: ',Total_Dirs:10:0);
  884.             WRITELN( Output_File , Left_Margin_String,
  885.                      '    Files selected     : ',Total_Files:10:0);
  886.             WRITELN( Output_File , Left_Margin_String,
  887.                      '    Bytes in files     : ',Total_Space:10:0);
  888.             WRITELN( Output_File , Left_Margin_String,
  889.                      '    Bytes free         : ',
  890.                      Dir_Get_Free_Space( Cat_Drive ):10:0 );
  891.          END;
  892.                                    (* Close output file *)
  893.       (*$I-*)
  894.    CLOSE( Output_File );
  895.       (*$I+*)
  896.    IF ( IOResult <> 0 ) THEN;
  897.  
  898. END   (* Terminate *);
  899.  
  900. (*---------------------- Main Program of PIBCAT ------------------------*)
  901.  
  902. BEGIN (* PibCat *)
  903.                                    (* Initialize program.  If initialization *)
  904.                                    (* goes OK, then perform cataloguing.     *)
  905.    IF Initialize THEN
  906.       Perform_Cataloguing;
  907.                                    (* Close output file and terminate.       *)
  908.    Terminate;
  909.  
  910. END   (* PibCat *).